home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tcpech1a / clsscree.cls < prev    next >
Text File  |  1999-08-31  |  19KB  |  582 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsScreen"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. 'Constants
  17. Const MyModule = "clsScreen"
  18.  
  19. 'Hooked Variables - for every one you add, add it to class_terminate as well
  20. Public WithEvents mForm As Form
  21. Attribute mForm.VB_VarHelpID = -1
  22. Private WithEvents mToolbar As Toolbar
  23. Attribute mToolbar.VB_VarHelpID = -1
  24. Private mStatusBar As StatusBar
  25. Attribute mStatusBar.VB_VarHelpID = -1
  26. Private WithEvents mLstPlayers As ListBox
  27. Attribute mLstPlayers.VB_VarHelpID = -1
  28. Private WithEvents mLstGMs As ListBox
  29. Attribute mLstGMs.VB_VarHelpID = -1
  30. Private WithEvents mPicLights As PictureBox
  31. Attribute mPicLights.VB_VarHelpID = -1
  32. Private WithEvents mTxtInput As TextBox
  33. Attribute mTxtInput.VB_VarHelpID = -1
  34.  
  35. Friend Sub Init()
  36. '------------------------------------------------------------
  37. 'Initialize the screen settings
  38. '------------------------------------------------------------
  39.     Const MyError = MyModule & "_" & "Init"
  40.     If Timings Then PerformanceStartTime MyError
  41.     On Error GoTo Err_Init
  42.  
  43. '------------------------------------------------------------
  44. 'Hook the form to capture its events
  45. '------------------------------------------------------------
  46.     Load frmServer
  47.     Set mForm = frmServer
  48.     mForm_Load
  49.     'mForm.ControlBox = False
  50.     
  51. '------------------------------------------------------------
  52. 'Initialize the toolbar
  53. '------------------------------------------------------------
  54.  
  55.     Set mToolbar = mForm.Toolbar1
  56.     mToolbar.ImageList = mForm.imgListToolbar
  57.     mToolbar.Appearance = ccFlat
  58.     mToolbar.Wrappable = True
  59.     mToolbar.AllowCustomize = False
  60.     mToolbar.RestoreToolbar "Incarnation Server", "Settings", "mToolbar"
  61.    
  62.     With mToolbar.Buttons
  63.         .Add , "Upload", "Upload Client", , "Upload"
  64.         .Add , "Record", "Record", , "Microphone"
  65.         .Add , "PlaySound", "Play", , "Sound"
  66.         .Add , "Time", "Time", , "Time"
  67.         .Add , "Weather", "Weather", , "Sun"
  68.         .Add , "Sessions", "Sessions", , "Sessions"
  69.         .Add , "Timings", "Timings", , "Timings"
  70.         .Add , "Monsters", "Spawning", , "Hamster"
  71.         .Add , "Warning", "Warning", , "Warning"
  72.         .Add , "Quit", "Shutdown", , "Stop"
  73.     End With
  74.         
  75.     'Set up sub-buttons.
  76.     With mToolbar.Buttons(3)
  77.         .Style = tbrDropdown
  78.         .ButtonMenus.Add , "Recorded", "Recorded Message"
  79.         .ButtonMenus.Add , "Midi1", "Midi 1"
  80.         .ButtonMenus.Add , "Welcome", "Welcome"
  81.     End With
  82.     
  83.     With mToolbar.Buttons(4)
  84.         .Style = tbrDropdown
  85.         .ButtonMenus.Add , , "Midnight"
  86.         .ButtonMenus.Add , , "01:00 AM"
  87.         .ButtonMenus.Add , , "02:00 AM"
  88.         .ButtonMenus.Add , , "03:00 AM"
  89.         .ButtonMenus.Add , , "04:00 AM"
  90.         .ButtonMenus.Add , , "05:00 AM"
  91.         .ButtonMenus.Add , , "06:00 AM"
  92.         .ButtonMenus.Add , , "07:00 AM"
  93.         .ButtonMenus.Add , , "08:00 AM"
  94.         .ButtonMenus.Add , , "09:00 AM"
  95.         .ButtonMenus.Add , , "10:00 AM"
  96.         .ButtonMenus.Add , , "12:00 AM"
  97.         .ButtonMenus.Add , , "Noon"
  98.         .ButtonMenus.Add , , "01:00 PM"
  99.         .ButtonMenus.Add , , "02:00 PM"
  100.         .ButtonMenus.Add , , "03:00 PM"
  101.         .ButtonMenus.Add , , "04:00 PM"
  102.         .ButtonMenus.Add , , "05:00 PM"
  103.         .ButtonMenus.Add , , "06:00 PM"
  104.         .ButtonMenus.Add , , "07:00 PM"
  105.         .ButtonMenus.Add , , "08:00 PM"
  106.         .ButtonMenus.Add , , "09:00 PM"
  107.         .ButtonMenus.Add , , "10:00 PM"
  108.         .ButtonMenus.Add , , "11:00 PM"
  109.     End With
  110.     
  111.     With mToolbar.Buttons(5)
  112.         .Style = tbrDropdown
  113.         .ButtonMenus.Add , "Sun", "Sun"
  114.         .ButtonMenus.Add , "Rain", "Rain"
  115.         .ButtonMenus.Add , "Snow", "Snow"
  116.     End With
  117.     
  118.     With mToolbar.Buttons(7)
  119.         .Style = tbrDropdown
  120.         .ButtonMenus.Add , "Display", "Display To Screen"
  121.         .ButtonMenus.Add , "File", "Write To File"
  122.         .ButtonMenus.Add , , "-"
  123.         .ButtonMenus.Add , "TurnOn", "Turn On Timings"
  124.         .ButtonMenus.Add , "TurnOff", "Turn Off Timings"
  125.     End With
  126.     
  127. '------------------------------------------------------------
  128. 'Initialize the status bar
  129. '------------------------------------------------------------
  130.     Set mStatusBar = mForm.StatusBar1
  131.     With mStatusBar
  132.         .Panels.Clear
  133.         .Panels.Add , "pnl1"
  134.         .Panels.Add , "pnl2"
  135.         .Panels.Add , "pnlTime"
  136.         Time = G.CurrentTime
  137.     End With
  138.  
  139. '------------------------------------------------------------
  140. 'Initialize the player list
  141. '------------------------------------------------------------
  142.     Set mLstPlayers = mForm.lstPlayers
  143.     Set mLstGMs = mForm.lstGMs
  144.     mLstPlayers.Visible = True
  145.     mLstGMs.Visible = False
  146.     
  147. '------------------------------------------------------------
  148. 'Initialize the flashing lights
  149. '------------------------------------------------------------
  150.     Set mPicLights = mForm.picLights
  151.     mPicLights.Width = 505
  152.     mPicLights.Height = 100
  153.     'mPicLights.DrawWidth = 4
  154.     mPicLights.FillStyle = 0
  155.  
  156. '------------------------------------------------------------
  157. 'Rearrange the controls on the form
  158. '------------------------------------------------------------
  159.     mForm_Resize
  160.  
  161. '------------------------------------------------------------
  162. 'Initialize the input box
  163. '------------------------------------------------------------
  164.     Set mTxtInput = mForm.txtInput
  165.     
  166. '------------------------------------------------------------
  167. 'Show the form
  168. '------------------------------------------------------------
  169.     mForm.Visible = True
  170.  
  171. '------------------------------------------------------------
  172. 'End of procedure
  173. '------------------------------------------------------------
  174.     If Timings Then PerformanceEndTime MyError
  175.     Exit Sub
  176.     
  177. Err_Init:
  178.     CScreen.DebugText = MyError & ": " & Err.Number & " - " & Err.Description
  179.     Resume Next
  180. End Sub
  181.  
  182. Friend Property Let DebugText(ByVal s As String)
  183. '------------------------------------------------------------
  184. 'Writes text to the server debug display
  185. '------------------------------------------------------------
  186.  
  187.     Dim chars As Long
  188.     Const MyError = MyModule & "_" & "DebugText"
  189.     If Timings Then PerformanceStartTime MyError
  190.  
  191.     On Error GoTo Err_Init
  192.     
  193.     If Right$(s, 2) = vbCrLf Then
  194.         'skip it
  195.     Else
  196.         s = s & vbCrLf
  197.     End If
  198.     
  199.     'Update server debug display
  200.     With mForm.txtDebug
  201.         chars = Len(.Text)
  202.         If chars > 15000 Then
  203.             .Text = Right(.Text, 1000)
  204.             chars = Len(.Text)
  205.         End If
  206.         If Len(s) > 15000 Then
  207.             s = Right(s, 15000)
  208.         End If
  209.         .SelStart = chars
  210.         .SelText = Format(Now) & " " & s
  211.         .SelStart = Len(.Text)
  212.     End With
  213.     
  214.     If Timings Then PerformanceEndTime MyError
  215.     Exit Property
  216.     
  217. Err_Init:
  218.     Debug.Print Err.Number & " - " & Err.Description
  219.     Resume Next
  220. End Property
  221.  
  222. Friend Property Let OutputText(ByVal s As String)
  223. '------------------------------------------------------------
  224. 'Writes text to the server output display
  225. '------------------------------------------------------------
  226.  
  227.     Dim chars As Long
  228.     Const MyError = MyModule & "_" & "OutputText"
  229.     If Timings Then PerformanceStartTime MyError
  230.  
  231.     On Error GoTo Err_Init
  232.     
  233.     If Right$(s, 2) = vbCrLf Then
  234.         'skip it
  235.     Else
  236.         s = s & vbCrLf
  237.     End If
  238.     
  239.     'Update server debug display
  240.     With mForm.txtOutput
  241.         chars = Len(.Text)
  242.         If chars > 100000 Then
  243.             .Text = ""
  244.             chars = 0
  245.             '.Text = Right(.Text, 1000)
  246.             'chars = Len(.Text)
  247.         End If
  248.         If Len(s) > 80000 Then
  249.             s = Right(s, 80000)
  250.